home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Pocket 6.3 / Examples / Sieve < prev    next >
Encoding:
Text File  |  1992-05-07  |  1.1 KB  |  38 lines  |  [TEXT/McSk]
  1. ( Sleeve of Erastothanes for version 0.6 )
  2. ( optomized for Pocket Forth with inline machine code )
  3. ( based on a letter by Don Colburn in DDJ #83 )
  4. forget task : task ;  decimal  0 28 +md !
  5.  
  6. ( tenth second timer )
  7. : START ( -- d ) 362 0 dl@ ;  ( get 'ticks' )
  8. : T. ( sec -- ) s>d <# # 46 hold #S #> type ;  ( print sec.tenths )
  9. : STOP ( d -- ) start cr 2swap dnegate d+ drop  6 / t. ." sec." ;
  10.  
  11. ( compile machine code inline routines )
  12. : R+ ( n -- n+r ) ( add the loop index to the number on the stack )
  13.     ,$ 3017 ,$ D156 ; macro  ( move.w [rs],d0 add.w d0,[ps] )
  14. : 0RC! ( -- ) ( clear the byte pointed to by the index loop )
  15.     ,$ 3017 ,$ 4233 ,$ 0 ; macro  ( move.w [rs],d0 clr.b 0[bp,d0] )
  16.  
  17. 8190 constant SIZE
  18. variable FLAGS size allot
  19.  
  20. : PRIME  flags size 1 fill
  21.     0 size 0 DO
  22.       flags r+ c@ IF
  23.         3 r+ r+ dup r+ size < IF
  24.           size flags + over r+ flags +
  25.           DO  0rc! dup  +LOOP
  26.         THEN drop 1+
  27.       THEN
  28.     LOOP . ." primes" cr ;
  29.  
  30. : SIEVE  page  ."        The Sieve of Erastothanes" decimal
  31.     cr  start  10 BEGIN prime 1- DUP 0= UNTIL DROP stop
  32.     beep cr  ." Not too shabby, eh?"  cr ;
  33.  
  34. 0 28 +md !
  35. sieve
  36.  
  37.  
  38.